home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / fngsrc.sit / Finger 1.3.5 Source / Common Units / FingerDaemon.unit next >
Encoding:
Text File  |  1992-02-24  |  9.0 KB  |  336 lines
  1. unit FingerDaemon;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6.  
  7. interface
  8.  
  9.     uses
  10.         TCPTypes, TCPStuff, ParameterDef;
  11.  
  12.     const
  13.         fingerd_strh = 200;
  14.         maxplansize_index = 2;
  15.         maxtokens_index = 4;
  16.         fingerd_port_index = 6;
  17.         daemons_max_index = 8;
  18.  
  19.     procedure InitDaemon;
  20.     procedure FinishDaemon;
  21.     procedure SendPlan (tcpc: TCPConnectionPtr; vrn: integer; dirID: longInt; name, user: str63);
  22.     procedure IdleFingers;
  23.  
  24. implementation
  25.  
  26.     uses
  27.         MyFileSystem, MyTranslate82728, MyTrackidle;
  28.  
  29.     const
  30.         cr = 13;
  31.         lf = 10;
  32.         specchar = ord('%');
  33.         fingerd_proc_type = 'PROC';
  34.  
  35.     var
  36.         hastempmem: boolean;
  37.         trans: transTable;
  38.         max_plan_size, max_token_count: longInt;
  39.  
  40.     function TempNewHandle (logicalSize: Size; var resultCode: OSErr): Handle;
  41.     inline
  42.         $3F3C, $001D, $A88F;
  43.     procedure TempHLock (h: Handle; var resultCode: OSErr);
  44.     inline
  45.         $3F3C, $001E, $A88F;
  46. {    procedure TempHUnlock (h: Handle; var resultCode: OSErr);}
  47. {    inline}
  48. {    $3F3C, $001F, $A88F;}
  49.     procedure TempDisposeHandle (h: Handle; var resultCode: OSErr);
  50.     inline
  51.         $3F3C, $0020, $A88F;
  52.  
  53.     procedure CallProc (var p: parameterRecord; proc: ptr);
  54.     inline
  55.         $205F, $4E90;
  56.  
  57.     function AddPtr (src: univ Ptr; offset: longint): Ptr;
  58.     inline
  59.         $201F,    { move.l        (sp)+,d0        ; pop offset }
  60.         $D09F,    { add.l            (sp)+,d0        ; add ptr to offset (and pop p) }
  61.         $2E80;    { move.l        d0,(sp)        ; place in result }
  62.  
  63.     procedure AddToPtr (var dst: univ Ptr; src: univ ptr; offset: longint);
  64.     inline
  65.         $201F,    { move.l        (sp)+,d0        ; pop offset }
  66.         $D09F,    { add.l            (sp)+,d0        ; add ptr to offset (and pop p) }
  67.         $205F,    { move.l        (sp)+,a0        ; pop address of p }
  68.         $2080;    { move.l        d0,(sp)        ; place in result }
  69.  
  70.     function MyTempNewHandle (logicalSize: Size; var resultCode: OSErr): Handle;
  71.     begin
  72.         if HasTempMem then
  73.             MyTempNewHandle := TempNewHandle(logicalSize, resultCode)
  74.         else begin
  75.             MyTempNewHandle := NewHandle(logicalSize);
  76.             resultCode := MemError;
  77.         end;
  78.     end;
  79.  
  80.     procedure MyTempHLock (h: Handle; var resultCode: OSErr);
  81.     begin
  82.         if HasTempMem then
  83.             TempHLock(h, resultCode)
  84.         else begin
  85.             HLock(h);
  86.             resultCode := MemError;
  87.         end;
  88.     end;
  89.  
  90.     procedure MyTempDisposeHandle (h: Handle; var resultCode: OSErr);
  91.     begin
  92.         if HasTempMem then
  93.             TempDisposeHandle(h, resultCode)
  94.         else begin
  95.             DisposHandle(h);
  96.             resultCode := MemError;
  97.         end;
  98.     end;
  99.  
  100.     procedure SendPlan (tcpc: TCPConnectionPtr; vrn: integer; dirID: longInt; name, user: str63);
  101.         procedure NoPlan;
  102.             var
  103.                 s: str31;
  104.                 oe: OSErr;
  105.         begin
  106.             s := concat('No Plan', chr(cr), chr(lf));
  107.             oe := TCPSendAsync(tcpc, @s[1], length(s), nil);
  108.         end;
  109.         procedure GetSpecial (p: ptr; var offset: longInt; count: longInt; var name: str63; var paramstr: str255);
  110.             type
  111.                 charSet = set of char;
  112.             procedure GetChars (cs: charSet);
  113.                 var
  114.                     initoff, len: longInt;
  115.             begin
  116.                 initoff := offset;
  117.                 while (offset < count) and (chr(AddPtr(p, offset)^) in cs) do
  118.                     offset := offset + 1;
  119.                 len := offset - initoff;
  120.                 if len > 255 then
  121.                     len := 255;
  122. {$PUSH}
  123. {$R-}
  124.                 paramstr[0] := chr(len);
  125.                 BlockMove(AddPtr(p, initoff), @paramstr[1], len);
  126. {$POP}
  127.                 len := Pos('-', paramstr);
  128.                 if len = 0 then begin
  129.                     name := paramstr;
  130.                     paramstr := '';
  131.                 end
  132.                 else begin
  133.                     name := copy(paramstr, 1, len - 1);
  134.                     paramstr := copy(paramstr, len + 1, 255);
  135.                 end;
  136.             end;
  137.         begin
  138.             case chr(AddPtr(p, offset)^) of
  139.                 '"':  begin
  140.                     offset := offset + 1;
  141.                     GetChars([' '..'!', '#'..'~']);
  142.                     if chr(AddPtr(p, offset)^) = '"' then
  143.                         offset := offset + 1;
  144.                 end;
  145.                 '''':  begin
  146.                     offset := offset + 1;
  147.                     GetChars([' '..'&', '('..'~']);
  148.                     if chr(AddPtr(p, offset)^) = '''' then
  149.                         offset := offset + 1;
  150.                 end;
  151.                 otherwise
  152.                     GetChars(['A'..'Z', 'a'..'z', '0'..'9', '_', '-', ':']);
  153.             end;
  154.         end;
  155.         const
  156.             MyPIn = PIn;
  157.         var
  158.             oe, ooe: OSErr;
  159.             count: longInt;
  160.             refnum: integer;
  161.             hin, hout: handle;
  162.             pin, pout: ptr;
  163.             inoff, outoff, len, newin, i: longInt;
  164.             b: signedByte;
  165.             sysenv: SysEnvRec;
  166.             retval, paramstr: str255;
  167.             th: handle;
  168.             param: parameterRecord;
  169.             proch: handle;
  170.             localhost, charsavailable: longInt;
  171.             remoteport, localport, constate: integer;
  172.             oldvrn: integer;
  173.             oldvrnoe: OSErr;
  174.             tokencount: longInt;
  175.     begin
  176.         oldvrnoe := GetVol(nil, oldvrn);
  177.         tokencount := max_token_count;
  178.         oe := MFSOpenDF(refnum, vrn, dirID, name, MyPIn);
  179.         if oe <> noErr then begin
  180.             oe := SysEnvirons(1, sysenv);
  181.             if oe = noErr then
  182.                 ooe := SetVol(nil, sysenv.sysVRefNum);
  183.             oe := MFSOpenDF(refnum, sysenv.sysVRefNum, 0, ':Preferences:Plan', MyPIn);
  184.         end
  185.         else begin
  186.             ooe := SysEnvirons(1, sysenv);
  187.             if ooe = noErr then
  188.                 ooe := SetVol(nil, sysenv.sysVRefNum);
  189.         end;
  190.         if oe = noErr then begin
  191.             hout := MyTempNewHandle(max_plan_size + 1, oe);
  192.             if oe = noErr then begin
  193.                 oe := GetEOF(refnum, count);
  194.                 if oe = noErr then
  195.                     hin := MyTempNewHandle(max_plan_size + 1, oe);
  196.                 if oe = noErr then begin
  197.                     MyTempHLock(hin, oe);
  198.                     if oe = noErr then
  199.                         MyTempHLock(hout, oe);
  200.                     if count > max_plan_size then
  201.                         count := max_plan_size;
  202.                     if oe = noErr then
  203.                         oe := FSRead(refnum, count, hin^);
  204.                     if oe = noErr then begin
  205.                         param.fingeredName := @user;
  206.                         param.param := @paramstr;
  207.                         param.returnValue := @retval;
  208.                         param.fingeroutput := hout;
  209.                         param.idle := (TickCount - IdleSince) div 60;
  210.                         TCPRawState(tcpc, constate, localhost, localport, param.remoteIP, remoteport, charsavailable);
  211.                         inoff := 0;
  212.                         outoff := 0;
  213.                         pin := hin^;
  214.                         while (outoff <= max_plan_size - 2) and (inoff < count) do begin
  215.                             b := pin^;
  216.                             AddToPtr(pin, pin, 1);
  217.                             inoff := inoff + 1;
  218.                             AddToPtr(pout, hout^, outoff);
  219.                             case b of
  220.                                 cr:  begin
  221.                                     pout^ := cr;
  222.                                     AddToPtr(pout, pout, 1);
  223.                                     pout^ := lf;
  224.                                     outoff := outoff + 2;
  225.                                 end;
  226.                                 lf: 
  227.                                     ;
  228.                                 specchar: 
  229.                                     if (pin^ = specchar) or (pin^ = 13) or (tokencount <= 0) then begin
  230.                                         if pin^ <> 13 then begin
  231.                                             pout^ := specchar;
  232.                                             outoff := outoff + 1;
  233.                                         end;
  234.                                         if (pin^ = specchar) or (pin^ = 13) then begin
  235.                                             AddToPtr(pin, pin, 1);
  236.                                             inoff := inoff + 1;
  237.                                         end;
  238.                                     end
  239.                                     else begin
  240.                                         retval := '';
  241.                                         GetSpecial(hin^, inoff, count, name, paramstr);
  242.                                         AddToPtr(pin, hin^, inoff);
  243.                                         proch := GetNamedResource(fingerd_proc_type, name);
  244.                                         if (proch <> nil) & (proch^ <> nil) then begin
  245.                                             tokencount := tokencount - 1;
  246.                                             if max_plan_size - outoff < max_plan_size - count + inoff then
  247.                                                 param.hlength := max_plan_size
  248.                                             else
  249.                                                 param.hlength := outoff + max_plan_size - count + inoff;
  250.                                             param.offset := outoff;
  251.                                             param.expandtokens := true;
  252.                                             HLock(proch);
  253.                                             CallProc(param, proch^);
  254.                                             HUnlock(proch);
  255.                                             HPurge(proch);
  256.                                             if param.expandtokens then begin
  257.                                                 len := param.offset - outoff;
  258.                                                 if len > 0 then begin
  259.                                                     if len > max_plan_size - count + inoff then
  260.                                                         len := max_plan_size - count + inoff;
  261.                                                     BlockMove(AddPtr(hin^, inoff), AddPtr(hin^, len), count - inoff);
  262.                                                     BlockMove(AddPtr(hout^, outoff), hin^, len);
  263.                                                     count := len + count - inoff;
  264.                                                     inoff := 0;
  265.                                                     pin := ptr(hin^);
  266.                                                 end;
  267.                                             end
  268.                                             else
  269.                                                 outoff := param.offset;
  270.                                         end
  271.                                         else
  272.                                             retval := concat('?', name, '?');
  273.                                         AddToPtr(pout, hout^, outoff);
  274.                                         len := length(retval);
  275.                                         if len > param.hlength - outoff then
  276.                                             len := param.hlength - outoff;
  277.                                         if len > 0 then begin
  278.                                             BlockMove(@retval[1], pout, len);
  279.                                             for i := 1 to length(retval) do begin
  280.                                                 pout^ := trans[BAND(pout^, $FF)];
  281.                                                 longInt(pout) := longInt(pout) + 1;
  282.                                             end;
  283.                                             outoff := outoff + len;
  284.                                         end;
  285.                                     end;
  286.                                 otherwise begin
  287.                                     pout^ := trans[BAND(b, $FF)];
  288.                                     outoff := outoff + 1;
  289.                                 end;
  290.                             end; {case}
  291.                         end;{while}
  292.                         ooe := TCPSendAsync(tcpc, hout^, outoff, nil);
  293.                     end;
  294.                     MyTempDisposeHandle(hin, ooe);
  295.                 end;
  296.                 MyTempDisposeHandle(hout, ooe);
  297.             end;
  298.             ooe := FSClose(refnum);
  299.         end;{if open}
  300.         if oe <> noErr then
  301.             NoPlan;
  302.         if oldvrnoe = noErr then
  303.             oe := SetVol(nil, oldvrn);
  304.     end;
  305.  
  306.     procedure IdleFingers;
  307.     begin
  308.         TrackIdle;
  309.     end;
  310.  
  311.     procedure InitDaemon;
  312.         var
  313.             s: str255;
  314.             th: handle;
  315.             gv: longInt;
  316.             oe: OSErr;
  317.             i: integer;
  318.     begin
  319.         InitTrackIdle;
  320.         GetIndString(s, fingerd_strh, maxplansize_index);
  321.         StringToNum(s, max_plan_size);
  322.         if max_plan_size < 1000 then
  323.             max_plan_size := 1000;
  324.         GetIndString(s, fingerd_strh, maxtokens_index);
  325.         StringToNum(s, max_token_count);
  326.         GetTrans(translateOutResID, trans);
  327.         oe := Gestalt(gestaltOSAttr, gv);
  328.         hastempmem := (oe = noErr) and BTST(gv, gestaltTempMemSupport);
  329.     end;
  330.  
  331.     procedure FinishDaemon;
  332.     begin
  333.         FinishTrackIdle;
  334.     end;
  335.  
  336. end.